home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 7 / Apprentice-Release7.iso / Source Code / C / Applications / Tcl-Tk 8.0 / Pre-installed version / tcl8.0 / generic / tclPipe.c < prev    next >
Encoding:
C/C++ Source or Header  |  1997-08-15  |  29.7 KB  |  1,052 lines  |  [TEXT/CWIE]
  1. /* 
  2.  * tclPipe.c --
  3.  *
  4.  *    This file contains the generic portion of the command channel
  5.  *    driver as well as various utility routines used in managing
  6.  *    subprocesses.
  7.  *
  8.  * Copyright (c) 1997 by Sun Microsystems, Inc.
  9.  *
  10.  * See the file "license.terms" for information on usage and redistribution
  11.  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  12.  *
  13.  * SCCS: @(#) tclPipe.c 1.8 97/06/20 13:26:45
  14.  */
  15.  
  16. #include "tclInt.h"
  17. #include "tclPort.h"
  18.  
  19. /*
  20.  * A linked list of the following structures is used to keep track
  21.  * of child processes that have been detached but haven't exited
  22.  * yet, so we can make sure that they're properly "reaped" (officially
  23.  * waited for) and don't lie around as zombies cluttering the
  24.  * system.
  25.  */
  26.  
  27. typedef struct Detached {
  28.     Tcl_Pid pid;            /* Id of process that's been detached
  29.                      * but isn't known to have exited. */
  30.     struct Detached *nextPtr;        /* Next in list of all detached
  31.                      * processes. */
  32. } Detached;
  33.  
  34. static Detached *detList = NULL;    /* List of all detached proceses. */
  35.  
  36. /*
  37.  * Declarations for local procedures defined in this file:
  38.  */
  39.  
  40. static TclFile    FileForRedirect _ANSI_ARGS_((Tcl_Interp *interp,
  41.                 char *spec, int atOk, char *arg, char *nextArg, 
  42.             int flags, int *skipPtr, int *closePtr, int *releasePtr));
  43.  
  44. /*
  45.  *----------------------------------------------------------------------
  46.  *
  47.  * FileForRedirect --
  48.  *
  49.  *    This procedure does much of the work of parsing redirection
  50.  *    operators.  It handles "@" if specified and allowed, and a file
  51.  *    name, and opens the file if necessary.
  52.  *
  53.  * Results:
  54.  *    The return value is the descriptor number for the file.  If an
  55.  *    error occurs then NULL is returned and an error message is left
  56.  *    in interp->result.  Several arguments are side-effected; see
  57.  *    the argument list below for details.
  58.  *
  59.  * Side effects:
  60.  *    None.
  61.  *
  62.  *----------------------------------------------------------------------
  63.  */
  64.  
  65. static TclFile
  66. FileForRedirect(interp, spec, atOK, arg, nextArg, flags, skipPtr, closePtr,
  67.     releasePtr)
  68.     Tcl_Interp *interp;        /* Intepreter to use for error reporting. */
  69.     char *spec;            /* Points to character just after
  70.                  * redirection character. */
  71.     char *arg;            /* Pointer to entire argument containing 
  72.                  * spec:  used for error reporting. */
  73.     int atOK;            /* Non-zero means that '@' notation can be 
  74.                  * used to specify a channel, zero means that
  75.                  * it isn't. */
  76.     char *nextArg;        /* Next argument in argc/argv array, if needed 
  77.                  * for file name or channel name.  May be 
  78.                  * NULL. */
  79.     int flags;            /* Flags to use for opening file or to 
  80.                  * specify mode for channel. */
  81.     int *skipPtr;        /* Filled with 1 if redirection target was
  82.                  * in spec, 2 if it was in nextArg. */
  83.     int *closePtr;        /* Filled with one if the caller should 
  84.                  * close the file when done with it, zero
  85.                  * otherwise. */
  86.     int *releasePtr;
  87. {
  88.     int writing = (flags & O_WRONLY);
  89.     Tcl_Channel chan;
  90.     TclFile file;
  91.  
  92.     *skipPtr = 1;
  93.     if ((atOK != 0)  && (*spec == '@')) {
  94.     spec++;
  95.     if (*spec == '\0') {
  96.         spec = nextArg;
  97.         if (spec == NULL) {
  98.         goto badLastArg;
  99.         }
  100.         *skipPtr = 2;
  101.     }
  102.         chan = Tcl_GetChannel(interp, spec, NULL);
  103.         if (chan == (Tcl_Channel) NULL) {
  104.             return NULL;
  105.         }
  106.     file = TclpMakeFile(chan, writing ? TCL_WRITABLE : TCL_READABLE);
  107.         if (file == NULL) {
  108.             Tcl_AppendResult(interp, "channel \"", Tcl_GetChannelName(chan),
  109.                     "\" wasn't opened for ",
  110.                     ((writing) ? "writing" : "reading"), (char *) NULL);
  111.             return NULL;
  112.         }
  113.     *releasePtr = 1;
  114.     if (writing) {
  115.  
  116.         /*
  117.          * Be sure to flush output to the file, so that anything
  118.          * written by the child appears after stuff we've already
  119.          * written.
  120.          */
  121.  
  122.             Tcl_Flush(chan);
  123.     }
  124.     } else {
  125.     char *name;
  126.     Tcl_DString nameString;
  127.  
  128.     if (*spec == '\0') {
  129.         spec = nextArg;
  130.         if (spec == NULL) {
  131.         goto badLastArg;
  132.         }
  133.         *skipPtr = 2;
  134.     }
  135.     name = Tcl_TranslateFileName(interp, spec, &nameString);
  136.     if (name != NULL) {
  137.         file = TclpOpenFile(name, flags);
  138.     } else {
  139.         file = NULL;
  140.     }
  141.     Tcl_DStringFree(&nameString);
  142.     if (file == NULL) {
  143.         Tcl_AppendResult(interp, "couldn't ",
  144.             ((writing) ? "write" : "read"), " file \"", spec, "\": ",
  145.             Tcl_PosixError(interp), (char *) NULL);
  146.         return NULL;
  147.     }
  148.         *closePtr = 1;
  149.     }
  150.     return file;
  151.  
  152.     badLastArg:
  153.     Tcl_AppendResult(interp, "can't specify \"", arg,
  154.         "\" as last word in command", (char *) NULL);
  155.     return NULL;
  156. }
  157.  
  158. /*
  159.  *----------------------------------------------------------------------
  160.  *
  161.  * Tcl_DetachPids --
  162.  *
  163.  *    This procedure is called to indicate that one or more child
  164.  *    processes have been placed in background and will never be
  165.  *    waited for;  they should eventually be reaped by
  166.  *    Tcl_ReapDetachedProcs.
  167.  *
  168.  * Results:
  169.  *    None.
  170.  *
  171.  * Side effects:
  172.  *    None.
  173.  *
  174.  *----------------------------------------------------------------------
  175.  */
  176.  
  177. void
  178. Tcl_DetachPids(numPids, pidPtr)
  179.     int numPids;        /* Number of pids to detach:  gives size
  180.                  * of array pointed to by pidPtr. */
  181.     Tcl_Pid *pidPtr;        /* Array of pids to detach. */
  182. {
  183.     register Detached *detPtr;
  184.     int i;
  185.  
  186.     for (i = 0; i < numPids; i++) {
  187.     detPtr = (Detached *) ckalloc(sizeof(Detached));
  188.     detPtr->pid = pidPtr[i];
  189.     detPtr->nextPtr = detList;
  190.     detList = detPtr;
  191.     }
  192. }
  193.  
  194. /*
  195.  *----------------------------------------------------------------------
  196.  *
  197.  * Tcl_ReapDetachedProcs --
  198.  *
  199.  *    This procedure checks to see if any detached processes have
  200.  *    exited and, if so, it "reaps" them by officially waiting on
  201.  *    them.  It should be called "occasionally" to make sure that
  202.  *    all detached processes are eventually reaped.
  203.  *
  204.  * Results:
  205.  *    None.
  206.  *
  207.  * Side effects:
  208.  *    Processes are waited on, so that they can be reaped by the
  209.  *    system.
  210.  *
  211.  *----------------------------------------------------------------------
  212.  */
  213.  
  214. void
  215. Tcl_ReapDetachedProcs()
  216. {
  217.     register Detached *detPtr;
  218.     Detached *nextPtr, *prevPtr;
  219.     int status;
  220.     Tcl_Pid pid;
  221.  
  222.     for (detPtr = detList, prevPtr = NULL; detPtr != NULL; ) {
  223.     pid = Tcl_WaitPid(detPtr->pid, &status, WNOHANG);
  224.     if ((pid == 0) || ((pid == (Tcl_Pid) -1) && (errno != ECHILD))) {
  225.         prevPtr = detPtr;
  226.         detPtr = detPtr->nextPtr;
  227.         continue;
  228.     }
  229.     nextPtr = detPtr->nextPtr;
  230.     if (prevPtr == NULL) {
  231.         detList = detPtr->nextPtr;
  232.     } else {
  233.         prevPtr->nextPtr = detPtr->nextPtr;
  234.     }
  235.     ckfree((char *) detPtr);
  236.     detPtr = nextPtr;
  237.     }
  238. }
  239.  
  240. /*
  241.  *----------------------------------------------------------------------
  242.  *
  243.  * TclCleanupChildren --
  244.  *
  245.  *    This is a utility procedure used to wait for child processes
  246.  *    to exit, record information about abnormal exits, and then
  247.  *    collect any stderr output generated by them.
  248.  *
  249.  * Results:
  250.  *    The return value is a standard Tcl result.  If anything at
  251.  *    weird happened with the child processes, TCL_ERROR is returned
  252.  *    and a message is left in interp->result.
  253.  *
  254.  * Side effects:
  255.  *    If the last character of interp->result is a newline, then it
  256.  *    is removed unless keepNewline is non-zero.  File errorId gets
  257.  *    closed, and pidPtr is freed back to the storage allocator.
  258.  *
  259.  *----------------------------------------------------------------------
  260.  */
  261.  
  262. int
  263. TclCleanupChildren(interp, numPids, pidPtr, errorChan)
  264.     Tcl_Interp *interp;        /* Used for error messages. */
  265.     int numPids;        /* Number of entries in pidPtr array. */
  266.     Tcl_Pid *pidPtr;        /* Array of process ids of children. */
  267.     Tcl_Channel errorChan;    /* Channel for file containing stderr output
  268.                  * from pipeline.  NULL means there isn't any
  269.                  * stderr output. */
  270. {
  271.     int result = TCL_OK;
  272.     int i, abnormalExit, anyErrorInfo;
  273.     Tcl_Pid pid;
  274.     WAIT_STATUS_TYPE waitStatus;
  275.     char *msg;
  276.  
  277.     abnormalExit = 0;
  278.     for (i = 0; i < numPids; i++) {
  279.         pid = Tcl_WaitPid(pidPtr[i], (int *) &waitStatus, 0);
  280.     if (pid == (Tcl_Pid) -1) {
  281.         result = TCL_ERROR;
  282.             if (interp != (Tcl_Interp *) NULL) {
  283.                 msg = Tcl_PosixError(interp);
  284.                 if (errno == ECHILD) {
  285.             /*
  286.                      * This changeup in message suggested by Mark Diekhans
  287.                      * to remind people that ECHILD errors can occur on
  288.                      * some systems if SIGCHLD isn't in its default state.
  289.                      */
  290.  
  291.                     msg =
  292.                         "child process lost (is SIGCHLD ignored or trapped?)";
  293.                 }
  294.                 Tcl_AppendResult(interp, "error waiting for process to exit: ",
  295.                         msg, (char *) NULL);
  296.             }
  297.         continue;
  298.     }
  299.  
  300.     /*
  301.      * Create error messages for unusual process exits.  An
  302.      * extra newline gets appended to each error message, but
  303.      * it gets removed below (in the same fashion that an
  304.      * extra newline in the command's output is removed).
  305.      */
  306.  
  307.     if (!WIFEXITED(waitStatus) || (WEXITSTATUS(waitStatus) != 0)) {
  308.         char msg1[20], msg2[20];
  309.  
  310.         result = TCL_ERROR;
  311.         sprintf(msg1, "%ld", TclpGetPid(pid));
  312.         if (WIFEXITED(waitStatus)) {
  313.                 if (interp != (Tcl_Interp *) NULL) {
  314.                     sprintf(msg2, "%d", WEXITSTATUS(waitStatus));
  315.                     Tcl_SetErrorCode(interp, "CHILDSTATUS", msg1, msg2,
  316.                             (char *) NULL);
  317.                 }
  318.         abnormalExit = 1;
  319.         } else if (WIFSIGNALED(waitStatus)) {
  320.                 if (interp != (Tcl_Interp *) NULL) {
  321.                     char *p;
  322.                     
  323.                     p = Tcl_SignalMsg((int) (WTERMSIG(waitStatus)));
  324.                     Tcl_SetErrorCode(interp, "CHILDKILLED", msg1,
  325.                             Tcl_SignalId((int) (WTERMSIG(waitStatus))), p,
  326.                             (char *) NULL);
  327.                     Tcl_AppendResult(interp, "child killed: ", p, "\n",
  328.                             (char *) NULL);
  329.                 }
  330.         } else if (WIFSTOPPED(waitStatus)) {
  331.                 if (interp != (Tcl_Interp *) NULL) {
  332.                     char *p;
  333.  
  334.                     p = Tcl_SignalMsg((int) (WSTOPSIG(waitStatus)));
  335.                     Tcl_SetErrorCode(interp, "CHILDSUSP", msg1,
  336.                             Tcl_SignalId((int) (WSTOPSIG(waitStatus))),
  337.                             p, (char *) NULL);
  338.                     Tcl_AppendResult(interp, "child suspended: ", p, "\n",
  339.                             (char *) NULL);
  340.                 }
  341.         } else {
  342.                 if (interp != (Tcl_Interp *) NULL) {
  343.                     Tcl_AppendResult(interp,
  344.                             "child wait status didn't make sense\n",
  345.                             (char *) NULL);
  346.                 }
  347.         }
  348.     }
  349.     }
  350.  
  351.     /*
  352.      * Read the standard error file.  If there's anything there,
  353.      * then return an error and add the file's contents to the result
  354.      * string.
  355.      */
  356.  
  357.     anyErrorInfo = 0;
  358.     if (errorChan != NULL) {
  359.  
  360.     /*
  361.      * Make sure we start at the beginning of the file.
  362.      */
  363.  
  364.     Tcl_Seek(errorChan, 0L, SEEK_SET);
  365.  
  366.         if (interp != (Tcl_Interp *) NULL) {
  367.             while (1) {
  368. #define BUFFER_SIZE 1000
  369.                 char buffer[BUFFER_SIZE+1];
  370.                 int count;
  371.     
  372.                 count = Tcl_Read(errorChan, buffer, BUFFER_SIZE);
  373.                 if (count == 0) {
  374.                     break;
  375.                 }
  376.                 result = TCL_ERROR;
  377.                 if (count < 0) {
  378.                     Tcl_AppendResult(interp,
  379.                             "error reading stderr output file: ",
  380.                             Tcl_PosixError(interp), (char *) NULL);
  381.                     break;    /* out of the "while (1)" loop. */
  382.                 }
  383.                 buffer[count] = 0;
  384.                 Tcl_AppendResult(interp, buffer, (char *) NULL);
  385.                 anyErrorInfo = 1;
  386.             }
  387.         }
  388.         
  389.     Tcl_Close((Tcl_Interp *) NULL, errorChan);
  390.     }
  391.  
  392.     /*
  393.      * If a child exited abnormally but didn't output any error information
  394.      * at all, generate an error message here.
  395.      */
  396.  
  397.     if (abnormalExit && !anyErrorInfo && (interp != (Tcl_Interp *) NULL)) {
  398.     Tcl_AppendResult(interp, "child process exited abnormally",
  399.         (char *) NULL);
  400.     }
  401.     
  402.     return result;
  403. }
  404.  
  405. /*
  406.  *----------------------------------------------------------------------
  407.  *
  408.  * TclCreatePipeline --
  409.  *
  410.  *    Given an argc/argv array, instantiate a pipeline of processes
  411.  *    as described by the argv.
  412.  *
  413.  *    This procedure is unofficially exported for use by BLT.
  414.  *
  415.  * Results:
  416.  *    The return value is a count of the number of new processes
  417.  *    created, or -1 if an error occurred while creating the pipeline.
  418.  *    *pidArrayPtr is filled in with the address of a dynamically
  419.  *    allocated array giving the ids of all of the processes.  It
  420.  *    is up to the caller to free this array when it isn't needed
  421.  *    anymore.  If inPipePtr is non-NULL, *inPipePtr is filled in
  422.  *    with the file id for the input pipe for the pipeline (if any):
  423.  *    the caller must eventually close this file.  If outPipePtr
  424.  *    isn't NULL, then *outPipePtr is filled in with the file id
  425.  *    for the output pipe from the pipeline:  the caller must close
  426.  *    this file.  If errFilePtr isn't NULL, then *errFilePtr is filled
  427.  *    with a file id that may be used to read error output after the
  428.  *    pipeline completes.
  429.  *
  430.  * Side effects:
  431.  *    Processes and pipes are created.
  432.  *
  433.  *----------------------------------------------------------------------
  434.  */
  435.  
  436. int
  437. TclCreatePipeline(interp, argc, argv, pidArrayPtr, inPipePtr,
  438.     outPipePtr, errFilePtr)
  439.     Tcl_Interp *interp;        /* Interpreter to use for error reporting. */
  440.     int argc;            /* Number of entries in argv. */
  441.     char **argv;        /* Array of strings describing commands in
  442.                  * pipeline plus I/O redirection with <,
  443.                  * <<,  >, etc.  Argv[argc] must be NULL. */
  444.     Tcl_Pid **pidArrayPtr;    /* Word at *pidArrayPtr gets filled in with
  445.                  * address of array of pids for processes
  446.                  * in pipeline (first pid is first process
  447.                  * in pipeline). */
  448.     TclFile *inPipePtr;        /* If non-NULL, input to the pipeline comes
  449.                  * from a pipe (unless overridden by
  450.                  * redirection in the command).  The file
  451.                  * id with which to write to this pipe is
  452.                  * stored at *inPipePtr.  NULL means command
  453.                  * specified its own input source. */
  454.     TclFile *outPipePtr;    /* If non-NULL, output to the pipeline goes
  455.                  * to a pipe, unless overriden by redirection
  456.                  * in the command.  The file id with which to
  457.                  * read frome this pipe is stored at
  458.                  * *outPipePtr.  NULL means command specified
  459.                  * its own output sink. */
  460.     TclFile *errFilePtr;    /* If non-NULL, all stderr output from the
  461.                  * pipeline will go to a temporary file
  462.                  * created here, and a descriptor to read
  463.                  * the file will be left at *errFilePtr.
  464.                  * The file will be removed already, so
  465.                  * closing this descriptor will be the end
  466.                  * of the file.  If this is NULL, then
  467.                  * all stderr output goes to our stderr.
  468.                  * If the pipeline specifies redirection
  469.                  * then the file will still be created
  470.                  * but it will never get any data. */
  471. {
  472.     Tcl_Pid *pidPtr = NULL;    /* Points to malloc-ed array holding all
  473.                  * the pids of child processes. */
  474.     int numPids;        /* Actual number of processes that exist
  475.                  * at *pidPtr right now. */
  476.     int cmdCount;        /* Count of number of distinct commands
  477.                  * found in argc/argv. */
  478.     char *inputLiteral = NULL;    /* If non-null, then this points to a
  479.                  * string containing input data (specified
  480.                  * via <<) to be piped to the first process
  481.                  * in the pipeline. */
  482.     TclFile inputFile = NULL;    /* If != NULL, gives file to use as input for
  483.                  * first process in pipeline (specified via <
  484.                  * or <@). */
  485.     int inputClose = 0;        /* If non-zero, then inputFile should be 
  486.                      * closed when cleaning up. */
  487.     int inputRelease = 0;
  488.     TclFile outputFile = NULL;    /* Writable file for output from last command
  489.                  * in pipeline (could be file or pipe).  NULL
  490.                  * means use stdout. */
  491.     int outputClose = 0;    /* If non-zero, then outputFile should be 
  492.                      * closed when cleaning up. */
  493.     int outputRelease = 0;
  494.     TclFile errorFile = NULL;    /* Writable file for error output from all
  495.                  * commands in pipeline.  NULL means use
  496.                  * stderr. */
  497.     int errorClose = 0;        /* If non-zero, then errorFile should be 
  498.                      * closed when cleaning up. */
  499.     int errorRelease = 0;
  500.     char *p;
  501.     int skip, lastBar, lastArg, i, j, atOK, flags, errorToOutput;
  502.     Tcl_DString execBuffer;
  503.     TclFile pipeIn;
  504.     TclFile curInFile, curOutFile, curErrFile;
  505.     Tcl_Channel channel;
  506.  
  507.     if (inPipePtr != NULL) {
  508.     *inPipePtr = NULL;
  509.     }
  510.     if (outPipePtr != NULL) {
  511.     *outPipePtr = NULL;
  512.     }
  513.     if (errFilePtr != NULL) {
  514.     *errFilePtr = NULL;
  515.     }
  516.  
  517.     Tcl_DStringInit(&execBuffer);
  518.     
  519.     pipeIn = NULL;
  520.     curInFile = NULL;
  521.     curOutFile = NULL;
  522.     numPids = 0;
  523.  
  524.     /*
  525.      * First, scan through all the arguments to figure out the structure
  526.      * of the pipeline.  Process all of the input and output redirection
  527.      * arguments and remove them from the argument list in the pipeline.
  528.      * Count the number of distinct processes (it's the number of "|"
  529.      * arguments plus one) but don't remove the "|" arguments because 
  530.      * they'll be used in the second pass to seperate the individual 
  531.      * child processes.  Cannot start the child processes in this pass 
  532.      * because the redirection symbols may appear anywhere in the 
  533.      * command line -- e.g., the '<' that specifies the input to the 
  534.      * entire pipe may appear at the very end of the argument list.
  535.      */
  536.  
  537.     lastBar = -1;
  538.     cmdCount = 1;
  539.     for (i = 0; i < argc; i++) {
  540.         skip = 0;
  541.     p = argv[i];
  542.     switch (*p++) {
  543.     case '|':
  544.         if (*p == '&') {
  545.         p++;
  546.         }
  547.         if (*p == '\0') {
  548.         if ((i == (lastBar + 1)) || (i == (argc - 1))) {
  549.             Tcl_SetResult(interp,
  550.                 "illegal use of | or |& in command",
  551.                 TCL_STATIC);
  552.             goto error;
  553.         }
  554.         }
  555.         lastBar = i;
  556.         cmdCount++;
  557.         break;
  558.  
  559.     case '<':
  560.         if (inputClose != 0) {
  561.         inputClose = 0;
  562.         TclpCloseFile(inputFile);
  563.         }
  564.         if (inputRelease != 0) {
  565.         inputRelease = 0;
  566.         TclpReleaseFile(inputFile);
  567.         }
  568.         if (*p == '<') {
  569.         inputFile = NULL;
  570.         inputLiteral = p + 1;
  571.         skip = 1;
  572.         if (*inputLiteral == '\0') {
  573.             inputLiteral = argv[i + 1];
  574.             if (inputLiteral == NULL) {
  575.             Tcl_AppendResult(interp, "can't specify \"", argv[i],
  576.                 "\" as last word in command", (char *) NULL);
  577.             goto error;
  578.             }
  579.             skip = 2;
  580.         }
  581.         } else {
  582.         inputLiteral = NULL;
  583.         inputFile = FileForRedirect(interp, p, 1, argv[i], 
  584.             argv[i + 1], O_RDONLY, &skip, &inputClose, &inputRelease);
  585.         if (inputFile == NULL) {
  586.             goto error;
  587.         }
  588.         }
  589.         break;
  590.  
  591.     case '>':
  592.         atOK = 1;
  593.         flags = O_WRONLY | O_CREAT | O_TRUNC;
  594.         errorToOutput = 0;
  595.         if (*p == '>') {
  596.         p++;
  597.         atOK = 0;
  598.         flags = O_WRONLY | O_CREAT;
  599.         }
  600.         if (*p == '&') {
  601.         if (errorClose != 0) {
  602.             errorClose = 0;
  603.             TclpCloseFile(errorFile);
  604.         }
  605.         errorToOutput = 1;
  606.         p++;
  607.         }
  608.  
  609.         /*
  610.          * Close the old output file, but only if the error file is
  611.          * not also using it.
  612.          */
  613.  
  614.         if (outputClose != 0) {
  615.         outputClose = 0;
  616.         if (errorFile == outputFile) {
  617.             errorClose = 1;
  618.         } else {
  619.             TclpCloseFile(outputFile);
  620.         }
  621.         }
  622.         if (outputRelease != 0) {
  623.         outputRelease = 0;
  624.         if (errorFile == outputFile) {
  625.             errorRelease = 1;
  626.         } else {
  627.             TclpReleaseFile(outputFile);
  628.         }
  629.         }
  630.         outputFile = FileForRedirect(interp, p, atOK, argv[i], 
  631.             argv[i + 1], flags, &skip, &outputClose, &outputRelease);
  632.         if (outputFile == NULL) {
  633.         goto error;
  634.         }
  635.         if (errorToOutput) {
  636.         if (errorClose != 0) {
  637.             errorClose = 0;
  638.             TclpCloseFile(errorFile);
  639.         }
  640.         if (errorRelease != 0) {
  641.             errorRelease = 0;
  642.             TclpReleaseFile(errorFile);
  643.         }
  644.         errorFile = outputFile;
  645.         }
  646.         break;
  647.  
  648.     case '2':
  649.         if (*p != '>') {
  650.         break;
  651.         }
  652.         p++;
  653.         atOK = 1;
  654.         flags = O_WRONLY | O_CREAT | O_TRUNC;
  655.         if (*p == '>') {
  656.         p++;
  657.         atOK = 0;
  658.         flags = O_WRONLY | O_CREAT;
  659.         }
  660.         if (errorClose != 0) {
  661.         errorClose = 0;
  662.         TclpCloseFile(errorFile);
  663.         }
  664.         if (errorRelease != 0) {
  665.         errorRelease = 0;
  666.         TclpReleaseFile(errorFile);
  667.         }
  668.         errorFile = FileForRedirect(interp, p, atOK, argv[i], 
  669.             argv[i + 1], flags, &skip, &errorClose, &errorRelease);
  670.         if (errorFile == NULL) {
  671.         goto error;
  672.         }
  673.         break;
  674.     }
  675.  
  676.     if (skip != 0) {
  677.         for (j = i + skip; j < argc; j++) {
  678.         argv[j - skip] = argv[j];
  679.         }
  680.         argc -= skip;
  681.         i -= 1;
  682.     }
  683.     }
  684.  
  685.     if (inputFile == NULL) {
  686.     if (inputLiteral != NULL) {
  687.         /*
  688.          * The input for the first process is immediate data coming from
  689.          * Tcl.  Create a temporary file for it and put the data into the
  690.          * file.
  691.          */
  692.         inputFile = TclpCreateTempFile(inputLiteral, NULL);
  693.         if (inputFile == NULL) {
  694.         Tcl_AppendResult(interp,
  695.             "couldn't create input file for command: ",
  696.             Tcl_PosixError(interp), (char *) NULL);
  697.         goto error;
  698.         }
  699.         inputClose = 1;
  700.     } else if (inPipePtr != NULL) {
  701.         /*
  702.          * The input for the first process in the pipeline is to
  703.          * come from a pipe that can be written from by the caller.
  704.          */
  705.  
  706.         if (TclpCreatePipe(&inputFile, inPipePtr) == 0) {
  707.         Tcl_AppendResult(interp, 
  708.             "couldn't create input pipe for command: ",
  709.             Tcl_PosixError(interp), (char *) NULL);
  710.         goto error;
  711.         }
  712.         inputClose = 1;
  713.     } else {
  714.         /*
  715.          * The input for the first process comes from stdin.
  716.          */
  717.  
  718.         channel = Tcl_GetStdChannel(TCL_STDIN);
  719.         if (channel != NULL) {
  720.         inputFile = TclpMakeFile(channel, TCL_READABLE);
  721.         if (inputFile != NULL) {
  722.             inputRelease = 1;
  723.         }
  724.         }
  725.     }
  726.     }
  727.  
  728.     if (outputFile == NULL) {
  729.     if (outPipePtr != NULL) {
  730.         /*
  731.          * Output from the last process in the pipeline is to go to a
  732.          * pipe that can be read by the caller.
  733.          */
  734.  
  735.         if (TclpCreatePipe(outPipePtr, &outputFile) == 0) {
  736.         Tcl_AppendResult(interp, 
  737.             "couldn't create output pipe for command: ",
  738.             Tcl_PosixError(interp), (char *) NULL);
  739.         goto error;
  740.         }
  741.         outputClose = 1;
  742.     } else {
  743.         /*
  744.          * The output for the last process goes to stdout.
  745.          */
  746.  
  747.         channel = Tcl_GetStdChannel(TCL_STDOUT);
  748.         if (channel) {
  749.         outputFile = TclpMakeFile(channel, TCL_WRITABLE);
  750.         if (outputFile != NULL) {
  751.             outputRelease = 1;
  752.         }
  753.         }
  754.     }
  755.     }
  756.  
  757.     if (errorFile == NULL) {
  758.     if (errFilePtr != NULL) {
  759.         /*
  760.          * Set up the standard error output sink for the pipeline, if
  761.          * requested.  Use a temporary file which is opened, then deleted.
  762.          * Could potentially just use pipe, but if it filled up it could
  763.          * cause the pipeline to deadlock:  we'd be waiting for processes
  764.          * to complete before reading stderr, and processes couldn't 
  765.          * complete because stderr was backed up.
  766.          */
  767.  
  768.         errorFile = TclpCreateTempFile(NULL, NULL);
  769.         if (errorFile == NULL) {
  770.         Tcl_AppendResult(interp,
  771.             "couldn't create error file for command: ",
  772.             Tcl_PosixError(interp), (char *) NULL);
  773.         goto error;
  774.         }
  775.         *errFilePtr = errorFile;
  776.     } else {
  777.         /*
  778.          * Errors from the pipeline go to stderr.
  779.          */
  780.  
  781.         channel = Tcl_GetStdChannel(TCL_STDERR);
  782.         if (channel) {
  783.         errorFile = TclpMakeFile(channel, TCL_WRITABLE);
  784.         if (errorFile != NULL) {
  785.             errorRelease = 1;
  786.         }
  787.         }
  788.     }
  789.     }
  790.     
  791.     /*
  792.      * Scan through the argc array, creating a process for each
  793.      * group of arguments between the "|" characters.
  794.      */
  795.  
  796.     Tcl_ReapDetachedProcs();
  797.     pidPtr = (Tcl_Pid *) ckalloc((unsigned) (cmdCount * sizeof(Tcl_Pid)));
  798.  
  799.     curInFile = inputFile;
  800.  
  801.     for (i = 0; i < argc; i = lastArg + 1) { 
  802.     int joinThisError;
  803.     Tcl_Pid pid;
  804.  
  805.     /*
  806.      * Convert the program name into native form. 
  807.      */
  808.  
  809.     argv[i] = Tcl_TranslateFileName(interp, argv[i], &execBuffer);
  810.     if (argv[i] == NULL) {
  811.         goto error;
  812.     }
  813.  
  814.     /*
  815.      * Find the end of the current segment of the pipeline.
  816.      */
  817.  
  818.     joinThisError = 0;
  819.     for (lastArg = i; lastArg < argc; lastArg++) {
  820.         if (argv[lastArg][0] == '|') { 
  821.         if (argv[lastArg][1] == '\0') { 
  822.             break;
  823.         }
  824.         if ((argv[lastArg][1] == '&') && (argv[lastArg][2] == '\0')) {
  825.             joinThisError = 1;
  826.             break;
  827.         }
  828.         }
  829.     }
  830.     argv[lastArg] = NULL;
  831.  
  832.     /*
  833.      * If this is the last segment, use the specified outputFile.
  834.      * Otherwise create an intermediate pipe.  pipeIn will become the
  835.      * curInFile for the next segment of the pipe.
  836.      */
  837.  
  838.     if (lastArg == argc) { 
  839.         curOutFile = outputFile;
  840.     } else {
  841.         if (TclpCreatePipe(&pipeIn, &curOutFile) == 0) {
  842.         Tcl_AppendResult(interp, "couldn't create pipe: ",
  843.             Tcl_PosixError(interp), (char *) NULL);
  844.         goto error;
  845.         }
  846.     }
  847.  
  848.     if (joinThisError != 0) {
  849.         curErrFile = curOutFile;
  850.     } else {
  851.         curErrFile = errorFile;
  852.     }
  853.  
  854.     if (TclpCreateProcess(interp, lastArg - i, argv + i,
  855.         curInFile, curOutFile, curErrFile, &pid) != TCL_OK) {
  856.         goto error;
  857.     }
  858.     Tcl_DStringFree(&execBuffer);
  859.  
  860.     pidPtr[numPids] = pid;
  861.     numPids++;
  862.  
  863.     /*
  864.      * Close off our copies of file descriptors that were set up for
  865.      * this child, then set up the input for the next child.
  866.      */
  867.  
  868.     if ((curInFile != NULL) && (curInFile != inputFile)) {
  869.         TclpCloseFile(curInFile);
  870.     }
  871.     curInFile = pipeIn;
  872.     pipeIn = NULL;
  873.  
  874.     if ((curOutFile != NULL) && (curOutFile != outputFile)) {
  875.         TclpCloseFile(curOutFile);
  876.     }
  877.     curOutFile = NULL;
  878.     }
  879.  
  880.     *pidArrayPtr = pidPtr;
  881.  
  882.     /*
  883.      * All done.  Cleanup open files lying around and then return.
  884.      */
  885.  
  886. cleanup:
  887.     Tcl_DStringFree(&execBuffer);
  888.  
  889.     if (inputClose) {
  890.     TclpCloseFile(inputFile);
  891.     } else if (inputRelease) {
  892.     TclpReleaseFile(inputFile);
  893.     }
  894.     if (outputClose) {
  895.     TclpCloseFile(outputFile);
  896.     } else if (outputRelease) {
  897.     TclpReleaseFile(outputFile);
  898.     }
  899.     if (errorClose) {
  900.     TclpCloseFile(errorFile);
  901.     } else if (errorRelease) {
  902.     TclpReleaseFile(errorFile);
  903.     }
  904.     return numPids;
  905.  
  906.     /*
  907.      * An error occurred.  There could have been extra files open, such
  908.      * as pipes between children.  Clean them all up.  Detach any child
  909.      * processes that have been created.
  910.      */
  911.  
  912. error:
  913.     if (pipeIn != NULL) {
  914.     TclpCloseFile(pipeIn);
  915.     }
  916.     if ((curOutFile != NULL) && (curOutFile != outputFile)) {
  917.     TclpCloseFile(curOutFile);
  918.     }
  919.     if ((curInFile != NULL) && (curInFile != inputFile)) {
  920.     TclpCloseFile(curInFile);
  921.     }
  922.     if ((inPipePtr != NULL) && (*inPipePtr != NULL)) {
  923.     TclpCloseFile(*inPipePtr);
  924.     *inPipePtr = NULL;
  925.     }
  926.     if ((outPipePtr != NULL) && (*outPipePtr != NULL)) {
  927.     TclpCloseFile(*outPipePtr);
  928.     *outPipePtr = NULL;
  929.     }
  930.     if ((errFilePtr != NULL) && (*errFilePtr != NULL)) {
  931.     TclpCloseFile(*errFilePtr);
  932.     *errFilePtr = NULL;
  933.     }
  934.     if (pidPtr != NULL) {
  935.     for (i = 0; i < numPids; i++) {
  936.         if (pidPtr[i] != (Tcl_Pid) -1) {
  937.         Tcl_DetachPids(1, &pidPtr[i]);
  938.         }
  939.     }
  940.     ckfree((char *) pidPtr);
  941.     }
  942.     numPids = -1;
  943.     goto cleanup;
  944. }
  945.  
  946. /*
  947.  *----------------------------------------------------------------------
  948.  *
  949.  * Tcl_OpenCommandChannel --
  950.  *
  951.  *    Opens an I/O channel to one or more subprocesses specified
  952.  *    by argc and argv.  The flags argument determines the
  953.  *    disposition of the stdio handles.  If the TCL_STDIN flag is
  954.  *    set then the standard input for the first subprocess will
  955.  *    be tied to the channel:  writing to the channel will provide
  956.  *    input to the subprocess.  If TCL_STDIN is not set, then
  957.  *    standard input for the first subprocess will be the same as
  958.  *    this application's standard input.  If TCL_STDOUT is set then
  959.  *    standard output from the last subprocess can be read from the
  960.  *    channel;  otherwise it goes to this application's standard
  961.  *    output.  If TCL_STDERR is set, standard error output for all
  962.  *    subprocesses is returned to the channel and results in an error
  963.  *    when the channel is closed;  otherwise it goes to this
  964.  *    application's standard error.  If TCL_ENFORCE_MODE is not set,
  965.  *    then argc and argv can redirect the stdio handles to override
  966.  *    TCL_STDIN, TCL_STDOUT, and TCL_STDERR;  if it is set, then it 
  967.  *    is an error for argc and argv to override stdio channels for
  968.  *    which TCL_STDIN, TCL_STDOUT, and TCL_STDERR have been set.
  969.  *
  970.  * Results:
  971.  *    A new command channel, or NULL on failure with an error
  972.  *    message left in interp.
  973.  *
  974.  * Side effects:
  975.  *    Creates processes, opens pipes.
  976.  *
  977.  *----------------------------------------------------------------------
  978.  */
  979.  
  980. Tcl_Channel
  981. Tcl_OpenCommandChannel(interp, argc, argv, flags)
  982.     Tcl_Interp *interp;        /* Interpreter for error reporting. Can
  983.                                  * NOT be NULL. */
  984.     int argc;            /* How many arguments. */
  985.     char **argv;        /* Array of arguments for command pipe. */
  986.     int flags;            /* Or'ed combination of TCL_STDIN, TCL_STDOUT,
  987.                  * TCL_STDERR, and TCL_ENFORCE_MODE. */
  988. {
  989.     TclFile *inPipePtr, *outPipePtr, *errFilePtr;
  990.     TclFile inPipe, outPipe, errFile;
  991.     int numPids;
  992.     Tcl_Pid *pidPtr;
  993.     Tcl_Channel channel;
  994.  
  995.     inPipe = outPipe = errFile = NULL;
  996.  
  997.     inPipePtr = (flags & TCL_STDIN) ? &inPipe : NULL;
  998.     outPipePtr = (flags & TCL_STDOUT) ? &outPipe : NULL;
  999.     errFilePtr = (flags & TCL_STDERR) ? &errFile : NULL;
  1000.     
  1001.     numPids = TclCreatePipeline(interp, argc, argv, &pidPtr, inPipePtr,
  1002.             outPipePtr, errFilePtr);
  1003.  
  1004.     if (numPids < 0) {
  1005.     goto error;
  1006.     }
  1007.  
  1008.     /*
  1009.      * Verify that the pipes that were created satisfy the
  1010.      * readable/writable constraints. 
  1011.      */
  1012.  
  1013.     if (flags & TCL_ENFORCE_MODE) {
  1014.     if ((flags & TCL_STDOUT) && (outPipe == NULL)) {
  1015.         Tcl_AppendResult(interp, "can't read output from command:",
  1016.             " standard output was redirected", (char *) NULL);
  1017.         goto error;
  1018.     }
  1019.     if ((flags & TCL_STDIN) && (inPipe == NULL)) {
  1020.         Tcl_AppendResult(interp, "can't write input to command:",
  1021.             " standard input was redirected", (char *) NULL);
  1022.         goto error;
  1023.     }
  1024.     }
  1025.     
  1026.     channel = TclpCreateCommandChannel(outPipe, inPipe, errFile,
  1027.         numPids, pidPtr);
  1028.  
  1029.     if (channel == (Tcl_Channel) NULL) {
  1030.         Tcl_AppendResult(interp, "pipe for command could not be created",
  1031.                 (char *) NULL);
  1032.     goto error;
  1033.     }
  1034.     return channel;
  1035.  
  1036. error:
  1037.     if (numPids > 0) {
  1038.     Tcl_DetachPids(numPids, pidPtr);
  1039.     ckfree((char *) pidPtr);
  1040.     }
  1041.     if (inPipe != NULL) {
  1042.     TclpCloseFile(inPipe);
  1043.     }
  1044.     if (outPipe != NULL) {
  1045.     TclpCloseFile(outPipe);
  1046.     }
  1047.     if (errFile != NULL) {
  1048.     TclpCloseFile(errFile);
  1049.     }
  1050.     return NULL;
  1051. }
  1052.